0. Imports and Settings

library(broom)
library(cluster)
library(dplyr, warn.conflicts = FALSE)
library(GGally, warn.conflicts = FALSE)
library(ggdendro)
library(ggplot2)
library(ggfortify)
library(highcharter, quietly = TRUE)
## Highcharts (www.highcharts.com) is a Highsoft software product which is
## not free for commercial and Governmental use
library(knitr)
library(readr)
library(tibble)
library(tidyr)
require(Rtsne, quietly = TRUE)
source('multiplot.R')

1. Análise Descritiva

dados_all <- read_csv("data/capes-cacc.csv")
glimpse(dados_all)
## Observations: 75
## Variables: 31
## $ Instituição                <chr> "UNIVERSIDADE FEDERAL DO AMAZONAS",...
## $ Programa                   <chr> "INFORMÁTICA (12001015012P2)", "CIÊ...
## $ Nível                      <int> 5, 4, 3, 3, 3, 5, 4, 3, 3, 3, 5, 3,...
## $ Sigla                      <chr> "UFAM", "UFPA", "UFMA", "UEMA", "FU...
## $ Tem doutorado              <chr> "Sim", "Sim", "Não", "Não", "Não", ...
## $ Docentes colaboradores     <dbl> 0.25, 5.50, 3.00, 6.25, 1.75, 2.00,...
## $ Docentes permanentes       <dbl> 24.75, 14.00, 10.00, 14.00, 9.50, 2...
## $ Docentes visitantes        <dbl> 0.00, 0.00, 0.00, 0.00, 0.00, 0.75,...
## $ Resumos em conf            <int> 20, 23, 15, 5, 4, 10, 6, 136, 0, 24...
## $ Resumos expandidos em conf <int> 25, 24, 7, 10, 1, 68, 9, 13, 4, 6, ...
## $ Artigos em conf            <int> 390, 284, 115, 73, 150, 269, 179, 0...
## $ Dissertacoes               <int> 108, 77, 50, 25, 31, 75, 60, 129, 4...
## $ Teses                      <int> 14, NA, NA, NA, NA, 24, 5, NA, NA, ...
## $ periodicos_A1              <int> 15, 19, 5, 1, 7, 21, 21, 0, 3, 8, 4...
## $ periodicos_A2              <int> 19, 21, 11, 1, 4, 32, 13, 0, 9, 2, ...
## $ periodicos_B1              <int> 19, 38, 7, 3, 6, 26, 16, 2, 6, 4, 3...
## $ periodicos_B2              <int> 1, 12, 2, 6, 0, 0, 11, 0, 0, 2, 1, ...
## $ periodicos_B3              <int> 3, 16, 2, 2, 3, 16, 15, 0, 4, 6, 9,...
## $ periodicos_B4              <int> 0, 4, 0, 3, 3, 0, 1, 3, 1, 6, 0, 0,...
## $ periodicos_B5              <int> 10, 16, 8, 4, 12, 4, 16, 2, 6, 2, 1...
## $ periodicos_C               <int> 9, 34, 12, 5, 2, 3, 11, 9, 5, 10, 1...
## $ periodicos_NA              <int> 7, 15, 8, 11, 12, 6, 19, 31, 7, 14,...
## $ per_comaluno_A1            <int> 4, 1, 0, 0, 1, 7, 5, 0, 1, 0, 10, N...
## $ per_comaluno_A2            <int> 5, 5, 5, 0, 2, 15, 3, 0, 3, 0, 3, N...
## $ per_comaluno_B1            <int> 4, 2, 5, 2, 2, 14, 6, 0, 2, 0, 17, ...
## $ per_comaluno_B2            <int> 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 1, NA...
## $ per_comaluno_B3            <int> 2, 2, 0, 1, 0, 7, 9, 0, 2, 0, 4, NA...
## $ per_comaluno_B4            <int> 0, 0, 0, 0, 2, 0, 1, 0, 1, 3, 0, NA...
## $ per_comaluno_B5            <int> 5, 0, 4, 0, 8, 3, 6, 0, 4, 0, 4, NA...
## $ per_comaluno_C             <int> 6, 5, 3, 1, 2, 3, 7, 1, 2, 4, 8, NA...
## $ per_comaluno_NA            <int> 6, 14, 2, 2, 9, 3, 6, 4, 5, 1, 10, ...
dados <- dados_all %>%
  replace(is.na(.), 0) %>%
  mutate(periodicos_restrito = periodicos_A1 + periodicos_A2 + periodicos_B1) %>%
  mutate(periodicos_qualis = periodicos_B1 + periodicos_B2 + periodicos_B3 + periodicos_B4 + periodicos_B5) %>%
  select(instituicao = Instituição, 
         nivel = Nível, 
         colaboradores = `Docentes colaboradores`,
         permanentes = `Docentes permanentes`,
         artigos_conf = `Artigos em conf`,
         dissertacoes = Dissertacoes,
         teses = Teses,
         periodicos_restrito,
         periodicos_qualis)

dados %>% head()
## # A tibble: 6 × 9
##                              instituicao nivel colaboradores permanentes
##                                    <chr> <int>         <dbl>       <dbl>
## 1       UNIVERSIDADE FEDERAL DO AMAZONAS     5          0.25       24.75
## 2           UNIVERSIDADE FEDERAL DO PARÁ     4          5.50       14.00
## 3       UNIVERSIDADE FEDERAL DO MARANHÃO     3          3.00       10.00
## 4      UNIVERSIDADE ESTADUAL DO MARANHÃO     3          6.25       14.00
## 5 FUNDAÇÃO UNIVERSIDADE FEDERAL DO PIAUÍ     3          1.75        9.50
## 6          UNIVERSIDADE FEDERAL DO CEARÁ     5          2.00       20.75
## # ... with 5 more variables: artigos_conf <int>, dissertacoes <dbl>,
## #   teses <dbl>, periodicos_restrito <int>, periodicos_qualis <int>
dados %>%
  select(-instituicao) %>%
  summary()
##      nivel       colaboradores     permanentes     artigos_conf  
##  Min.   :3.000   Min.   : 0.000   Min.   : 3.00   Min.   :  0.0  
##  1st Qu.:3.000   1st Qu.: 1.125   1st Qu.:11.00   1st Qu.:121.5  
##  Median :3.000   Median : 3.000   Median :16.00   Median :187.0  
##  Mean   :3.813   Mean   : 3.990   Mean   :20.22   Mean   :239.6  
##  3rd Qu.:4.000   3rd Qu.: 5.625   3rd Qu.:25.50   3rd Qu.:293.5  
##  Max.   :7.000   Max.   :22.250   Max.   :67.25   Max.   :959.0  
##   dissertacoes        teses        periodicos_restrito periodicos_qualis
##  Min.   :  0.00   Min.   :  0.00   Min.   :  0.00      Min.   :  1.00   
##  1st Qu.: 35.50   1st Qu.:  0.00   1st Qu.: 17.50      1st Qu.: 18.50   
##  Median : 56.00   Median :  0.00   Median : 40.00      Median : 32.00   
##  Mean   : 73.77   Mean   : 14.56   Mean   : 56.87      Mean   : 42.39   
##  3rd Qu.:102.50   3rd Qu.: 14.00   3rd Qu.: 66.00      3rd Qu.: 53.00   
##  Max.   :433.00   Max.   :152.00   Max.   :355.00      Max.   :274.00
dados %>%
  summarise(sd(colaboradores), sd(permanentes), sd(artigos_conf), sd(dissertacoes), sd(teses), sd(periodicos_qualis), sd(periodicos_restrito))
## # A tibble: 1 × 7
##   `sd(colaboradores)` `sd(permanentes)` `sd(artigos_conf)`
##                 <dbl>             <dbl>              <dbl>
## 1            3.967444          12.35931             183.73
## # ... with 4 more variables: `sd(dissertacoes)` <dbl>, `sd(teses)` <dbl>,
## #   `sd(periodicos_qualis)` <dbl>, `sd(periodicos_restrito)` <dbl>
dados %>%
  select(-instituicao) %>%
  ggpairs()

dados %>%
  ggplot(aes(x = nivel)) +
  geom_bar()

dados %>%
  top_n(10, dissertacoes) %>%
  ggplot(aes(x = reorder(instituicao, dissertacoes), y = dissertacoes)) +
  geom_bar(stat = "identity") +
  coord_flip()

dados %>%
  top_n(10, teses) %>%
  ggplot(aes(x = reorder(instituicao, teses), y = teses)) +
  geom_bar(stat = "identity") +
  coord_flip()

dados %>%
  top_n(10, artigos_conf) %>%
  ggplot(aes(x = reorder(instituicao, artigos_conf), y = artigos_conf)) +
  geom_bar(stat = "identity") +
  coord_flip()

dados %>%
  top_n(10, periodicos_qualis) %>%
  ggplot(aes(x = reorder(instituicao, periodicos_qualis), y = periodicos_qualis)) +
  geom_bar(stat = "identity") +
  coord_flip()

dados %>%
  top_n(10, periodicos_restrito) %>%
  ggplot(aes(x = reorder(instituicao, periodicos_restrito), y = periodicos_restrito)) + 
  geom_bar(stat = "identity") +
  coord_flip()

plot_nivel <- dados %>%
  ggplot(aes(x = 0, y = nivel)) +
  geom_point(alpha = 0.3)

plot_colaboradores <- dados %>%
  ggplot(aes(x = 0, y = colaboradores)) +
  geom_point(alpha = 0.3)

plot_permanentes <- dados %>%
  ggplot(aes(x = 0, y = permanentes)) +
  geom_point(alpha = 0.3)

plot_artigos_conf <- dados %>%
  ggplot(aes(x = 0, y = artigos_conf)) +
  geom_point(alpha = 0.3)

plot_dissertacoes <- dados %>%
  ggplot(aes(x = 0, y = dissertacoes)) +
  geom_point(alpha = 0.3)

plot_teses <- dados %>%
  ggplot(aes(x = 0, y = teses)) +
  geom_point(alpha = 0.3)

plot_per_qualis <- dados %>%
  ggplot(aes(x = 0, y = periodicos_qualis)) +
  geom_point(alpha = 0.3)

plot_per_restrito <- dados %>%
  ggplot(aes(x = 0, y = periodicos_restrito)) +
  geom_point(alpha = 0.3)

multiplot(plot_nivel, plot_colaboradores, plot_permanentes, plot_artigos_conf, plot_dissertacoes, plot_teses, plot_per_qualis, plot_per_restrito, cols = 4)

2. Clusterização

dados_pro <- dados %>%
  mutate(colaboradores = as.vector(scale(colaboradores)),
         permanentes = as.vector(scale(permanentes)),
         artigos_conf = as.vector(scale(artigos_conf+1)),
         dissertacoes = as.vector(scale(dissertacoes+1)),
         teses = as.vector(scale(teses+1)),
         periodicos_qualis = as.vector(scale(periodicos_qualis+1)),
         periodicos_restrito = as.vector(scale(periodicos_restrito+1)))

dados_pro %>% head()
## # A tibble: 6 × 9
##                              instituicao nivel colaboradores permanentes
##                                    <chr> <int>         <dbl>       <dbl>
## 1       UNIVERSIDADE FEDERAL DO AMAZONAS     5    -0.9426725  0.36625548
## 2           UNIVERSIDADE FEDERAL DO PARÁ     4     0.3805977 -0.50353386
## 3       UNIVERSIDADE FEDERAL DO MARANHÃO     3    -0.2495310 -0.82717640
## 4      UNIVERSIDADE ESTADUAL DO MARANHÃO     3     0.5696363 -0.50353386
## 5 FUNDAÇÃO UNIVERSIDADE FEDERAL DO PIAUÍ     3    -0.5645953 -0.86763172
## 6          UNIVERSIDADE FEDERAL DO CEARÁ     5    -0.5015824  0.04261293
## # ... with 5 more variables: artigos_conf <dbl>, dissertacoes <dbl>,
## #   teses <dbl>, periodicos_restrito <dbl>, periodicos_qualis <dbl>

2.1 Clusterização Hierárquica

distancias = dados_pro %>%
  select(-instituicao) %>%
  dist(method = "maximum")

clust_hier <- distancias %>%
  hclust(method = "ward.D")

ggdendrogram(clust_hier, rotate = TRUE)

plot(silhouette(cutree(clust_hier, k = 4), distancias))

atribuicoes <- cbind(dados_pro, grupo = cutree(clust_hier, k = 4))

atribuicoes %>%
  select(-instituicao) %>%
  ggparcoord(columns = c(1:8), groupColumn="grupo", scale = "globalminmax") +
  facet_grid(paste("Grupo ", grupo) ~ .) +
  theme(legend.position = "none") +
  scale_y_continuous(breaks=c(0, 2, 4, 6))

2.2 K-Means

set.seed(1234)
explorando_k <- tibble(k = 2:12) %>%
  group_by(k) %>%
  do(
    kmeans(select(dados_pro, -instituicao), centers = .$k, nstart = 20) %>% glance()
  )

explorando_k %>%
  ggplot(aes(x = k, y = tot.withinss)) +
  geom_line() +
  geom_point() +
  scale_x_continuous(breaks=c(2:12))

explorando_k %>%
  ggplot(aes(x = k, y = betweenss/totss)) +
  geom_line() +
  geom_point() +
  scale_x_continuous(breaks = c(2:12))

km <- dados_pro %>%
  select(-instituicao) %>%
  kmeans(centers = 4, nstart = 20)

km %>%
  augment(dados_pro) %>%
  select(-instituicao) %>%
  ggparcoord(columns = c(1:8), groupColumn = ".cluster", scale = "globalminmax") +
  facet_grid(paste("Grupo ", .cluster) ~ .) +
  ylab("Z-score") +
  theme(legend.position = "none")

3. Redução da Dimensionalidade

Principal Component Analysis (PCA)

dados_pca <- dados_pro %>%
  select(-instituicao) %>%
  prcomp(scale = FALSE)

as.data.frame(dados_pca$rotation)
##                            PC1         PC2         PC3        PC4
## nivel               -0.3987424 -0.39555358  0.52035701 -0.3810568
## colaboradores       -0.1695414  0.87508615  0.01662147 -0.2867285
## permanentes         -0.3771071  0.01899928 -0.13278423  0.3423898
## artigos_conf        -0.3700856 -0.05045480 -0.18916490  0.5057392
## dissertacoes        -0.3444813  0.23179410  0.49771651  0.4396016
## teses               -0.3724407  0.02779968  0.13314825 -0.3641500
## periodicos_restrito -0.3847241 -0.13351003 -0.26950427 -0.1122760
## periodicos_qualis   -0.3573444 -0.05028613 -0.58090840 -0.2472224
##                             PC5          PC6         PC7         PC8
## nivel                0.45139603 -0.061567265  0.14935877 -0.19674669
## colaboradores        0.34877604  0.006328333 -0.01758259 -0.03156735
## permanentes          0.05036907  0.752704036  0.37063880 -0.12685934
## artigos_conf         0.32198135 -0.224705020 -0.58701560 -0.26492224
## dissertacoes        -0.37559807 -0.375097007  0.27893822  0.16448305
## teses               -0.59598147  0.281005984 -0.51732230 -0.09165590
## periodicos_restrito  0.14347490 -0.026733780 -0.05119914  0.85147105
## periodicos_qualis   -0.22701321 -0.398417983  0.38389078 -0.33698477
tidy(dados_pca, "pcs") %>%
  ggplot(aes(x = PC, y = cumulative, label = cumulative)) +
  geom_line() +
  geom_point() +
  geom_text(vjust = 1, hjust = -.1)

dados_pro_aug <- km %>% augment(dados)

dados_pca %>%
  augment(dados_pro_aug) %>%
  ggplot(aes(x = .fittedPC1, y = .fittedPC2, color = .cluster)) +
  geom_point(alpha = 0.8) +
  theme(legend.position = "none")

p = dados_pca %>%
  augment(dados_pro_aug) %>%
  hchart("scatter", hcaes(x = .fittedPC1, y = .fittedPC2, color = .cluster)) %>%
  hc_tooltip(pointFormat = "<b>{point.instituicao}</b><br>
                     Nível: {point.nivel}<br>
             Colaboradores: {point.colaboradores}<br>
               Permanentes: {point.permanentes}<br>
             Artigos Conf.: {point.artigos_conf}<br>
              Dissertações: {point.dissertacoes}<br>
                     Teses: {point.teses}<br>
                Per. A1-B1: {point.periodicos_restrito}<br>
                Per. B2-B5: {point.periodicos_qualis}")
p
autoplot(dados_pca, label = F, label.size = 3, shape = T, colour = km$cluster, loadings = TRUE, loadings.color = 'red', loadings.label = TRUE, loadings.label.size = 3, loadings.label.hjust=1.1)
## Warning in if (value %in% columns) {: a condição tem comprimento > 1 e
## somente o primeiro elemento será usado

t-SNE

set.seed(1234)
tsne.out = dados_pro %>%
  select(-instituicao) %>%
  Rtsne(perplexity = 20)

df <- as.data.frame(tsne.out$Y)
dados_tsne <- cbind(dados_pro_aug, df)

dados_tsne %>% 
  ggplot(aes(x = V1, y = V2, color = .cluster)) +
  geom_point(alpha = 0.8) +
  theme(legend.position = "none")

p <- dados_tsne %>%
  hchart("scatter", hcaes(x = V1, y = V2, color = .cluster)) %>%
  hc_tooltip(pointFormat = "<b>{point.instituicao}</b><br>
                     Nível: {point.nivel}<br>
             Colaboradores: {point.colaboradores}<br>
               Permanentes: {point.permanentes}<br>
             Artigos Conf.: {point.artigos_conf}<br>
              Dissertações: {point.dissertacoes}<br>
                     Teses: {point.teses}<br>
                Per. A1-B1: {point.periodicos_restrito}<br>
                Per. B2-B5: {point.periodicos_qualis}")

p